home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / MUI / DEFTII15.LHA / Deft II / Sources / Work.em < prev   
Encoding:
Text File  |  1994-11-06  |  8.4 KB  |  357 lines
  1. OPT MODULE
  2.  
  3.  
  4. ->*****
  5. ->** External modules
  6. ->*****
  7. MODULE 'libraries/mui'
  8. MODULE 'tools/boopsi' , 'tools/installhook'
  9. MODULE 'utility/tagitem' , 'utility/hooks'
  10. MODULE 'icon' , 'workbench/workbench'
  11. MODULE 'dos/dos' , 'dos/exall'
  12.  
  13. MODULE '*Locale'
  14. MODULE '*Defs'
  15. MODULE '*GUI_MUIB'
  16. MODULE '*Errors'
  17.  
  18.  
  19. ->*****
  20. ->** Error handling
  21. ->*****
  22. RAISE    "MEM"    IF    AllocDosObject()        =    NIL    ,
  23.         "MEM"    IF    ParsePatternNoCase()    =    -1
  24.  
  25.  
  26. ->*****
  27. ->** Constant definitions
  28. ->*****
  29. CONST    EXALL_BUFFER_SIZE    =    1024
  30.  
  31. ENUM    SCAN_OK            =    1    ,
  32.         STOP_SCAN                ,
  33.         INCORRECT_DIR            ,
  34.         SCAN_ERROR
  35.  
  36.  
  37. ->*****
  38. ->** Global variables
  39. ->*****
  40. EXPORT DEF deftII    :    PTR TO obj_app
  41. EXPORT DEF cat        :    PTR TO catalog_DeftII
  42. EXPORT DEF modified    :    LONG
  43.  
  44. DEF icon_pattern    :    PTR TO CHAR
  45. DEF matchfunc_hook    :    PTR TO hook
  46.  
  47.  
  48. /**********************************************************
  49. ** Initializes the icon_pattern to the '#?.info' pattern **
  50. **********************************************************/
  51. EXPORT PROC init_go()
  52.  
  53.     ParsePatternNoCase( '#?.info' , NEW icon_pattern[ 30 ] , 30 )
  54.     installhook( NEW matchfunc_hook , {matchfunc} )
  55.  
  56. ENDPROC
  57.  
  58.  
  59. /**************************************/
  60. /* Like StrCmp() but case insensitive */
  61. /**************************************/
  62. EXPORT PROC str_cmp_no_case( string1 : PTR TO CHAR , string2 : PTR TO CHAR )
  63.  
  64.     DEF same = FALSE
  65.  
  66. ->    DEF i =0 , same = TRUE , upper_char1 = 0 , upper_char2 = 0
  67. ->    WHILE same AND ( string1[ i ] <> 0 ) AND ( string2[ i ] <> 0 )
  68. ->        IF string1[ i ] <> string2[ i ]
  69. ->            upper_char1 := IF ( string1[ i ] >= "a" ) AND ( string1[ i ] <= "z" ) THEN string1[ i ] - 32 ELSE string1[ i ]
  70. ->            upper_char2 := IF ( string2[ i ] >= "a" ) AND ( string2[ i ] <= "z" ) THEN string2[ i ] - 32 ELSE string2[ i ]
  71. ->            IF upper_char1 <> upper_char2 THEN same := FALSE
  72. ->        ENDIF
  73. ->        INC i
  74. ->    ENDWHILE
  75. ->ENDPROC IF ( string1[ i ] = 0 ) AND ( string2[ i ] = 0 ) THEN TRUE ELSE FALSE
  76.  
  77.     MOVE.L    string1 , A1
  78.     CMPA.L    #0 , A1
  79.     BEQ.B    final_end
  80.     MOVE.L    string2 , A2
  81.     CMPA.L    #0 , A2
  82.     BEQ.B    final_end
  83. loop_while:
  84.     MOVE.B    (A1)+ , D1
  85.     MOVE.B    (A2)+ , D2
  86.     TST.B    D1
  87.     BNE.B    second_test
  88.     TST.B    D2
  89.     BNE.B    final_end
  90.     MOVE.L    #-1 , same
  91.     BRA.B    final_end
  92. second_test:
  93.     TST.B    D2
  94.     BEQ.B    final_end
  95. insidewhile:
  96.         CMP.B    D1 , D2
  97.         BEQ.B    loop_while
  98.         CMP.B    #"a" , D1
  99.         BCS.B    char1_ok
  100.         CMP.B    #"z" , D1
  101.         BHI.B    char1_ok
  102.         SUB.B    #32 , D1
  103. char1_ok:
  104.         CMP.B    #"a" , D2
  105.         BCS.B    char2_ok
  106.         CMP.B    #"z" , D2
  107.         BHI.B    char2_ok
  108.         SUB.B    #32 , D2
  109. char2_ok:
  110.         CMP.B    D1 , D2
  111.         BEQ.B    loop_while
  112. final_end:
  113.  
  114. ENDPROC same
  115.  
  116.  
  117. /**************************************************************/
  118. /* The function which runs the icon default tool replacements */
  119. /**************************************************************/
  120. EXPORT PROC go( error_messages )
  121.  
  122.     DEF wrong_path_met = FALSE
  123.     DEF path_str : PTR TO CHAR
  124.     DEF result , i = 0
  125.     DEF return = 0
  126.     DEF old_priority
  127.  
  128.     old_priority := SetTaskPri( FindTask( NIL ) , -5 )
  129.     
  130.     set( deftII.lv_paths , MUIA_List_Quiet , MUI_TRUE )
  131.  
  132.     REPEAT
  133.  
  134.         domethod( deftII.lv_paths , [ MUIM_List_GetEntry , i++ , {path_str} ] )
  135.         IF path_str <> NIL
  136.  
  137.             result := scan_dir( path_str , path_str , error_messages )
  138.  
  139.             IF result = INCORRECT_DIR
  140.  
  141.                 domethod( deftII.lv_paths , [ MUIM_List_Remove , i-- ] )
  142.                 wrong_path_met := TRUE
  143.  
  144.             ENDIF
  145.  
  146.         ENDIF
  147.  
  148.     UNTIL ( path_str = NIL ) OR ( result = STOP_SCAN ) OR ( result = SCAN_ERROR )
  149.  
  150.     IF wrong_path_met
  151.  
  152.         IF error_messages THEN deftII_error( cat.msg_Wrong_Path_Met.getstr() )
  153.         modified := TRUE
  154.  
  155.     ENDIF
  156.  
  157.     set( deftII.lv_paths , MUIA_List_Quiet , FALSE )
  158.  
  159.     set( deftII.tx_info , MUIA_Text_Contents , cat.msg_TX_info.getstr() )
  160.  
  161.     domethod( deftII.app , [ MUIM_MultiSet , MUIA_Disabled , FALSE ,
  162.             deftII.gr_paths , deftII.gr_default_tools ,
  163.             deftII.bt_go , deftII.bt_save_prefs , deftII.bt_about , deftII.bt_quit , NIL ] )
  164.  
  165.     SetTaskPri( FindTask( NIL ) , old_priority )
  166.  
  167.     IF wrong_path_met THEN return := 10
  168.     IF result = STOP_SCAN THEN return := return + 5
  169.     IF result = SCAN_ERROR THEN return := return + 100
  170.  
  171. ENDPROC return
  172.  
  173.  
  174. /**************************************************************/
  175. /* Recursively scan a directory to replace icon default tools */
  176. /**************************************************************/
  177. PROC scan_dir( dir_name : PTR TO CHAR , previous_path : PTR TO CHAR , error_messages ) HANDLE
  178.  
  179.     DEF eac : PTR TO exallcontrol
  180.     DEF fib : PTR TO fileinfoblock
  181.     DEF entry : PTR TO exalldata
  182.     DEF current_dir = NIL , parent_dir = NIL
  183.     DEF more = FALSE , i , j , found
  184.     DEF icon_name[ 32 ] : STRING , icon : PTR TO diskobject
  185.     DEF def_tool : PTR TO default_tool
  186.     DEF error_buf[ 81 ] : ARRAY OF CHAR , error_num
  187.     DEF complete_path[ 512 ] : STRING
  188.     DEF buffer : PTR TO CHAR
  189.     DEF scan_result , signals
  190.  
  191.     NEW buffer[ EXALL_BUFFER_SIZE ]
  192.     eac := ( eac := NIL ) BUT AllocDosObject( DOS_EXALLCONTROL , NIL )
  193.     fib := ( fib := NIL ) BUT AllocDosObject( DOS_FIB , NIL )
  194.  
  195.     IF ( current_dir := Lock( dir_name , SHARED_LOCK ) ) = NIL
  196.  
  197.         FreeDosObject( DOS_FIB , fib )
  198.         FreeDosObject( DOS_EXALLCONTROL , eac )
  199.         RETURN INCORRECT_DIR
  200.  
  201.     ENDIF
  202.  
  203.     IF Examine( current_dir , fib ) = FALSE
  204.  
  205.         UnLock( current_dir )
  206.         FreeDosObject( DOS_FIB , fib )
  207.         FreeDosObject( DOS_EXALLCONTROL , eac )
  208.         RETURN INCORRECT_DIR
  209.  
  210.     ENDIF
  211.  
  212.     IF fib.direntrytype < 0
  213.  
  214.         UnLock( current_dir )
  215.         FreeDosObject( DOS_FIB , fib )
  216.         FreeDosObject( DOS_EXALLCONTROL , eac )
  217.         RETURN INCORRECT_DIR
  218.  
  219.     ENDIF
  220.  
  221.     FreeDosObject( DOS_FIB , fib )    ;    fib := NIL
  222.     parent_dir := CurrentDir( current_dir )
  223.  
  224.     eac.lastkey := 0
  225.     eac.matchstring := NIL
  226.     eac.matchfunc := matchfunc_hook
  227.  
  228.     REPEAT
  229.  
  230.         more := ExAll( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  231.         error_num := IoErr()
  232.  
  233.         IF domethod( deftII.app , [ MUIM_Application_Input , {signals} ] ) = ID_BT_STOP
  234.  
  235.             IF more THEN ExAllEnd( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  236.             CurrentDir( parent_dir )
  237.             UnLock( current_dir )
  238.             FreeDosObject( DOS_EXALLCONTROL , eac )
  239.             RETURN STOP_SCAN
  240.  
  241.         ENDIF
  242.  
  243.         entry := buffer
  244.  
  245.         FOR i := 1 TO eac.entries
  246.  
  247.             IF entry.type >= 0
  248.  
  249.                 StrCopy( complete_path , previous_path , ALL )
  250.                 AddPart( complete_path , entry.name , 512 )
  251.                 SetStr( complete_path , StrLen( complete_path ) )
  252.  
  253.                 IF ( scan_result := scan_dir( entry.name , complete_path , error_messages ) ) <> SCAN_OK
  254.  
  255.                     ExAllEnd( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  256.                     CurrentDir( parent_dir )
  257.                     UnLock( current_dir )
  258.                     FreeDosObject( DOS_EXALLCONTROL , eac )
  259.                     RETURN scan_result
  260.  
  261.                 ENDIF
  262.  
  263.             ELSE
  264.  
  265.                 IF ( icon := GetDiskObject( StrCopy ( icon_name , entry.name , StrLen( entry.name ) - 5 ) ) ) <> NIL
  266.  
  267.                     IF icon.type = WBPROJECT
  268.  
  269.                         j := 0
  270.                         found := FALSE
  271.  
  272.                         REPEAT
  273.  
  274.                             domethod( deftII.lv_default_tools , [ MUIM_List_GetEntry , j++ , {def_tool} ] )
  275.  
  276.                             IF def_tool <> NIL
  277.  
  278.                                 IF def_tool.pattern
  279.  
  280.                                     found := MatchPatternNoCase( def_tool.pattern , icon.defaulttool )
  281.  
  282.                                 ELSE
  283.  
  284.                                     found := str_cmp_no_case( icon.defaulttool , def_tool.old )
  285.  
  286.                                 ENDIF
  287.  
  288.                             ENDIF
  289.  
  290.                         UNTIL ( def_tool = NIL ) OR found
  291.  
  292.                         IF found
  293.  
  294.                             IF str_cmp_no_case( icon.defaulttool , def_tool.new ) = FALSE
  295.  
  296.                                 icon.defaulttool :=  def_tool.new
  297.                                 PutDiskObject( icon_name , icon )
  298.                         
  299.                                 StrCopy( complete_path , previous_path , ALL )
  300.                                 AddPart( complete_path , entry.name , 512 )
  301.                                 SetStr( complete_path , StrLen( complete_path ) )
  302.                                 set( deftII.tx_info , MUIA_Text_Contents , complete_path )
  303.  
  304.                             ENDIF
  305.  
  306.                         ENDIF
  307.  
  308.                     ENDIF
  309.  
  310.                     FreeDiskObject( icon )
  311.  
  312.                 ENDIF
  313.  
  314.             ENDIF
  315.  
  316.             entry := entry.next
  317.  
  318.         ENDFOR
  319.  
  320.     UNTIL more = FALSE
  321.  
  322.     IF error_num <> ERROR_NO_MORE_ENTRIES
  323.  
  324.         CurrentDir( parent_dir )
  325.         UnLock( current_dir )
  326.         FreeDosObject( DOS_EXALLCONTROL , eac )
  327.  
  328.         Fault( error_num , NIL , error_buf , 80 )
  329.         IF error_messages THEN deftII_error( error_buf )
  330.  
  331.         RETURN SCAN_ERROR
  332.  
  333.     ENDIF
  334.  
  335.     CurrentDir( parent_dir )
  336.     UnLock( current_dir )
  337.     FreeDosObject( DOS_EXALLCONTROL , eac )
  338.     END buffer[ EXALL_BUFFER_SIZE ]
  339.  
  340. EXCEPT
  341.  
  342.     IF more THEN ExAllEnd( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  343.     IF parent_dir THEN CurrentDir( parent_dir )
  344.     IF current_dir THEN UnLock( current_dir )
  345.     IF fib THEN FreeDosObject( DOS_FIB , fib )
  346.     IF eac THEN FreeDosObject( DOS_EXALLCONTROL , eac )
  347.  
  348.     ReThrow()
  349.  
  350. ENDPROC SCAN_OK
  351.  
  352.  
  353. /**********************************************************************
  354. ** Hook function called by ExAll() to see if an entry is a directory **
  355. **********************************************************************/
  356. PROC matchfunc( hook , ptype : PTR TO LONG , ed : PTR TO exalldata ) RETURN ( ed.type >= 0 ) OR ( MatchPatternNoCase( icon_pattern , ed.name ) )
  357.